home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / fastdir.zip / TEST.PAS < prev   
Pascal/Delphi Source File  |  1993-06-15  |  6KB  |  191 lines
  1.  
  2. {$A+,B-,D+,E+,F-,G+,I+,L+,N-,O-,P-,Q-,R-,S+,T-,V-,X+,Y+}
  3. {$M 16384,0,655360}
  4.  
  5. { TEST OF FASTDIR UNIT }
  6. { You will need TPCrt and TPPick for TURBO POWER to use }
  7. { or you can modify to use some other pick list routine }
  8.  
  9. Uses DOS,TPCrt,FastDir,TPPick;
  10.  
  11. CONST
  12.     Row  : BYTE = 4;
  13.     Col  : BYTE = 4;
  14.     Rows : BYTE = 18;
  15.     Cols : BYTE = 57;
  16.  
  17. VAR
  18.      aList  : DirList;
  19.      bList  : DirList;
  20.      I      : Word;
  21.      fTYpe  : FileTypes;
  22.      aCh,
  23.      bCh    : WORD;
  24.      VA     : PickColorArray;
  25.      VB     : PickColorArray;
  26.      Title  : STRING;
  27.      Done   : BOOLEAN;
  28.      fName  : PathStr;
  29.  
  30.      FUNCTION FileNameString (VAR F : SearchRec) : STRING ;
  31.  
  32.      VAR  DT : DateTime;
  33.           AttrStr, FILESIZE, FileDate, FileTime : STRING [8];
  34.           Mo, Day, Yr,
  35.           Hr, Minute, Am_Pm : STRING [2];
  36.           Len : INTEGER;
  37.  
  38.      BEGIN
  39.  
  40.      AttrStr := '    ';
  41.  
  42.      IF (F.Attr AND Directory <> 0) THEN
  43.         FILESIZE := PadL ('<DIR>', 8) ELSE STR (F.Size : 10, FILESIZE);
  44.  
  45.      IF F.Attr AND ReadOnly <> 0 THEN AttrStr [1] := 'R';
  46.      IF F.Attr AND Hidden   <> 0 THEN AttrStr [2] := 'H';
  47.      IF F.Attr AND SysFile  <> 0 THEN AttrStr [3] := 'S';
  48.      IF F.Attr AND Archive  <> 0 THEN AttrStr [4] := 'A';
  49.  
  50.      UNPACKTIME (F.Time, DT);
  51.  
  52.      STR (DT.Month : 2, MO);
  53.      STR (DT.Day   : 2, Day);
  54.      STR (DT.Year - 1900 : 2, Yr);
  55.  
  56.      FileDate := Mo+'/'+Day+'/'+Yr;
  57.      FOR Len  := 1 TO Length(FileDate) DO
  58.          IF FileDate[Len] = #32 THEN FileDate[Len] := '0';
  59.  
  60.        CASE DT.Hour OF
  61.          0     : BEGIN
  62.                    DT.Hour := 12;
  63.                    IF DT.Min = 0
  64.                    THEN  Am_Pm := 'M '
  65.                    ELSE  Am_Pm := 'Am';
  66.                  END;
  67.          1..11 : Am_Pm := 'Am';
  68.          12    : IF DT.Min = 0
  69.                  THEN  Am_Pm := 'N '
  70.                  ELSE  Am_Pm := 'Pm';
  71.          13..23 : BEGIN
  72.                    DT.Hour := DT.Hour - 12;
  73.                    Am_Pm := 'Pm';
  74.                  END;
  75.        END; {case}
  76.  
  77.      STR (DT.Hour : 2, Hr);
  78.      STR (DT.Min  : 2, Minute);
  79.  
  80.      FileTime := Hr+':'+Minute + Am_Pm;
  81.      FOR Len  := 1 TO Length(FileTime) DO
  82.          IF FileTime[Len] = #32 THEN FileTime[Len] := '0';
  83.  
  84.      FileNameString := PadR(F.Name,  13) +
  85.                        PadR(FILESIZE, 9) +
  86.                        PadR(FileDate, 9) +
  87.                        PadR(FileTime, 8) +
  88.                        AttrStr;
  89.  
  90.      END;
  91.  
  92.      FUNCTION FileString (Item : WORD) : STRING; FAR;
  93.  
  94.      VAR
  95.         SR : SearchRec;
  96.  
  97.      BEGIN
  98.      FILLCHAR (SR, SIZEOF (SR), #0);
  99.      aList.Current := NthDirItem(aList,PRED(Item));
  100.      WITH SR, aList DO
  101.           BEGIN
  102.           SR.Name := Current ^.Name;
  103.           SR.Attr := Current ^.Attr;
  104.           SR.Time := Current ^.Time;
  105.           SR.Size := Current ^.Size;
  106.           END;
  107.      FileString := ' '+FileNameString (SR)+'  '+PadR(FileTypeString(aList.Current^.fType),6);
  108.      END;
  109.  
  110.      FUNCTION ArchiveString (Item : WORD) : STRING; FAR;
  111.  
  112.      VAR
  113.         SR : SearchRec;
  114.  
  115.      BEGIN
  116.      FILLCHAR (SR, SIZEOF (SR), #0);
  117.      bList.Current := NthDirItem(bList,PRED(Item));
  118.      WITH SR, bList DO
  119.           BEGIN
  120.           SR.Name := Current ^.Name;
  121.           SR.Attr := Current ^.Attr;
  122.           SR.Time := Current ^.Time;
  123.           SR.Size := Current ^.Size;
  124.           END;
  125.  
  126.      ArchiveString := FileNameString (SR) +'  '+PadR(FileTypeString(bList.Current^.fType),6);
  127.      END;
  128.  
  129. BEGIN
  130.  
  131.  ResetAttr(7);
  132.  clrscr;
  133.  FastFillWindow(25*80,#177,1,1,7);
  134.  
  135.  InitializeDir (aList);
  136.  GetCommandLine(aList.Mask);
  137.  
  138.  aList.Path := FExpand('\');
  139.  aList.Mask := '*.zip *.arj *.lzh *.arc';  { find multiple items }
  140.  aList.Recurse := TRUE;  { look in all sub dirs too }
  141.  
  142.  Title := aList.Path + aList.Mask;
  143.  
  144.  
  145.  GetFiles(aList,aList.Path,aList.Mask,LessName);
  146.  
  147.  SetPickColors (VA, 31, 31, 31, 126, 31, 127);
  148.  SetPickColors (VB, 79, 79, 79, 126, 79, 127);
  149.  TPPick.picksrch := stringpicksrch;
  150.  
  151.  Done := FALSE;
  152.  
  153.  REPEAT
  154.  IF PickWindow(@FileString, aList.Count, Col, Row, Cols, Rows, TRUE,
  155.           VA, ' '+Title+' ', aCH) THEN
  156.           case PickCmdNum of
  157.           PKSSelect : BEGIN
  158.  
  159.                       aList.Current := NthDirItem(aList,PRED(aCh));
  160.                       fName := FullPathName(aList.Current^.Path,aList.Current^.Name);
  161.  
  162.                       IF IsDir(fName) THEN
  163.                          BEGIN
  164.                          ReleaseFiles (aList);
  165.                          GetFiles(aList,fName,'*.*',LessName);
  166.                          Title := aList.Path+aList.Mask;
  167.                          aCh   := 0;
  168.                          END ELSE
  169.  
  170.                       IF IsArchive(fName) THEN
  171.                          BEGIN
  172.                          bCh := 0;
  173.                          GetFiles(bList,fName,'*.*',LessName);
  174.                          REPEAT
  175.                          IF PickWindow(@ArchiveString, bList.Count, Col+2, Row+2, Cols+2, Rows+2, TRUE,
  176.                              VB, ' '+bList.Path+bList.Mask+' ', bCh) THEN
  177.                          case PickCmdNum of
  178.                               PKSSelect : ;  { do whatever }
  179.                               PKSExit   : ReleaseFiles(bList);
  180.                          END;
  181.                          UNTIL (PickCmdNum = PKSEXIT);
  182.                          END;
  183.  
  184.                       END ;
  185.           PKSExit   : Done := TRUE;
  186.           END;
  187.  Until Done;
  188.  
  189. ReleaseFiles (aList);
  190. END.
  191.